/* REXX _bankxfer.zrx by the reverend (build 97) */ /*- built by rev-builder version 1.1 on 02 Jan 2003 at 11:11:19 -*/ /*- ------------------------------------------------------------------------ -*/ /*- Copyright (C) 2001 Ron Wilson -*/ /*- -*/ /*- This script is free, and can be modified for your personal use, but you -*/ /*- cannot copy or distribute this script or any derivative work based upon -*/ /*- this script without the express permission of the author. Your use of -*/ /*- this script is governed by the terms of the REV-LICENSE. -*/ /*- -*/ /*- This program is provided to you WITHOUT ANY WARRANTY, even the implied -*/ /*- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -*/ /*- REV-LICENSE for more details. -*/ /*- -*/ /*- A copy of the REV-LICENSE is available at: -*/ /*- http://thereverend.coastgames.com/tradewars/rev-license.html -*/ /*- ------------------------------------------------------------------------ -*/ /* description: this script transfers money to another player's bank account */ /* repeatedly until a given total is transfered. i use this a */ /* lot when i need to transfer large amounts of cash to another */ /* corp which i cannot join due to either alignment or game */ /* rules. simply have the other player keep withdrawing funds */ /* from his account so that the script can keep filling it back */ /* up. */ /* rev. 0 - initial release */ /* rev. 1 - efficiency improvement */ /* rev. 2 - library update */ /* rev. 3 - library update */ /* rev. 4 - added safety features */ /* rev. 5 - updated error handling */ call zoctimeout 30 call zocsynctime 500 globals=_setglobals() call on halt name _halt if \_pcheck("") then call _error "please start at the bank prompt." amount=0 amount=_asknum("how much to transfer?", amount, "c") if amount=0 then call _quit "script cancelled by user." warn="WARNING: type full name to be safe." trader=zocask("to who's account?", warn) if trader=warn then call _quit "script cancelled by user." if trader="##CANCEL##" then call _quit "script cancelled by user." call zocsend "d^M" if zocwait("")=640 then call _error "timeout" done=0 do while \done call zocsend "t"||trader||"^M" /* So, how can I help you Citizen? (?) ? T You have 500,000 credits in your account. Who do you want to transfer money to? Which Trader ? (Full or Partial Name) - ard Do you mean Joe Hard? No Do you mean Ardwin? Yes How many credits do you want to transfer? (0) 0 credits have been transferred from your account. So, how can I help you Citizen? (?) ? Q */ done2=0 do while \done2 ans=zocwaitmux("Do you mean ", "? Yes", "do you want to transfer? (") select when ans=0 then call _beep "alert.wav" when ans=1 then do parse value _lastline() with trader "? Yes" . end /*when*/ when ans=2 then done2=1 when ans=640 then call _error "timeout" end /*select*/ end /*do*/ if zocwait(")")=640 then call _error "timeout" trans=_stripint(_lastline()) if amount")=640 then call _error "timeout" if trans>0 then do amount=amount-trans call zocsend "d" if zocwait("to deposit? (")=640 then call _error "timeout" if zocwait(")")=640 then call _error "timeout" dep=_stripint(_lastline()) if dep>0 then call zocsend dep||"^M" else call _quit "out of cash." if zocwait("")=640 then call _error "timeout" end /*if*/ if amount=0 then done=1 else call zocdelay 1 end /*do*/ call _commsg "r", "transfer complete." call _quit "transfer complete." exit /*** THE REVEREND'S TW LIBRARY FOR ZOC/REXX ***/ /** _setglobals v.3 **/ _setglobals: procedure expose _verbose _monthdays _monthnames _baseday. (globals) _verbose=0 _monthdays="31;28;31;30;31;30;31;31;30;31;30;31" _monthnames="jan;feb;mar;apr;may;jun;jul;aug;sep;oct;nov;dec" _baseday.2000=730118 _baseday.2001=_baseday.2000+365+1 _baseday.2002=_baseday.2001+365 _baseday.2003=_baseday.2002+365 _baseday.2004=_baseday.2003+365 _baseday.2005=_baseday.2004+365+1 _baseday.2006=_baseday.2005+365 _baseday.2007=_baseday.2006+365 _baseday.2008=_baseday.2007+365 rslt="_g. _s. _p. _d. _v. _f. _m. _q. " rslt=rslt||"_ef. _es. _et. _ep. " rslt=rslt||"_path. _dist. _dtomsl. _dfrmsl. " rslt=rslt||"_bg. _nwi. _od. _sv. _pv. _bust. _vs. _vn. " rslt=rslt||"_olist1. _olist2. _clvlist1. _clvlist2. " rslt=rslt||"_verbose _monthdays _monthnames _baseday. " rslt=rslt||"globals reconnect scriptname lra " if arg(1,"E") then rslt=rslt||arg(1) rslt=_space(rslt) return rslt /** _halt v.3 **/ _halt: procedure expose (globals) call off halt call zocwriteln "^[[1;33m< user abort >^[[0m " exit return /** _pcheck v.4 **/ _pcheck: procedure expose (globals) pc1=arg(1) pc2=zocgetscreen(0, zocgetinfo("CURSOR-Y"), zocgetinfo("CURSOR-X")) rslt=0 do i=1 to _dwords(pc1,";") if _instr(_dword(pc1,i,";"),pc2,"cs") then rslt=1 end /*do*/ return rslt /** _error v.7 **/ _error: procedure expose (globals) call off halt if zocgetinfo("CURSOR-X")>0 then call zocwriteln call zocwrite _ansi("bt;frd")||"< script error" if arg(1,"E") then call zocwrite ": "||arg(1) call zocwriteln " >" call zocwriteln _ansi("bt;fye")||"< if this is a serious problem, email me at: the.reverend@coastgames.com > " call zocwriteln "< ZOC VERSION '"||zocgetinfo("VERSION")||"', OS '"||zocgetinfo("OSYS")||"', LOCATION '"||zocgetinfo("CONNECTEDTO")||"' >" if arg(2,"E") then call zocwriteln _ansi("bt;fgr")||"< "||arg(2)||" >" call zocwrite _ansi() call _beep "error.wav" if reconnect=1 & arg(1)="timeout" then do /* call zocdisconnect */ call zocwriteln _ansi("bt;fwh")||"< ATTEMPTING TO RECONNECT >" call zocdostring "^RUN=_connect.zrx sn="||scriptname end /*if*/ exit /** _asknum v.4 **/ _asknum: procedure expose (globals) do i=1 to 3 select when i=1 & arg(i,"E") then msg=arg(i) when i=1 then msg="enter an number:" when i=2 & arg(i,"E") then default=arg(i) when i=2 then default="" when i=3 & arg(i,"E") then cflag=min(verify(lower(arg(i)),"c","M"),1) when i=3 then cflag=0 otherwise nop end /*select*/ end /*do*/ rslt=strip(zocask(msg, default)) do while _stripnum(rslt)\=rslt | rslt="" default=rslt||" [please enter a number or ESC to cancel.]" if rslt="##CANCEL##" then leave else rslt=strip(zocask(msg, default)) end /*do*/ if cflag & rslt="##CANCEL##" then call _quit "script cancelled by user.", "nocopy" return rslt /** _quit v.7 **/ _quit: procedure expose (globals) lcpy=1 arg1="" do i=1 to 2 /* manage arguments */ select when arg(i,"E") & lower(arg(i))="nocopy" then lcpy=0 when arg(i,"E") & arg1="" then arg1=arg(i) otherwise nop end /*select*/ end /*do*/ line=zocgetscreen(0, zocgetinfo("CURSOR-Y"), zocgetinfo("CURSOR-X")) select /* define message */ when lcpy & arg1="" then msg="^[[1;32m< end script >^[[0m^M^J"||line when \lcpy & arg1="" then msg="^[[1;32m< end script >^[[0m " when lcpy then msg="^[[1;32m^M^J< end script: "||arg1||" >^[[0m^M^J"||line when \lcpy then msg="^[[1;32m^M^J< end script: "||arg1||" >^[[0m " otherwise nop end /*select*/ call zocwrite msg select /* choose a beep */ when lower(arg1)="script cancelled by user." then call _beep "cancel.wav" otherwise call _beep "quit.wav" end /*select*/ exit return 1 /** _beep v.2 **/ _beep: procedure expose (globals) select when arg(1,"O") then call zocwrite d2c(7) when _fileexists(arg(1)) then call zocplaysound arg(1) otherwise call zocwrite d2c(7) end /*select*/ return /** _lastline v.3 **/ _lastline: procedure expose (globals) rslt=zoclastline() select when lower(arg(1))="raw" then nop when pos(d2c(7),rslt)>0 then rslt=translate(zocstring("REMOVE", rslt, d2c(7))," ",d2c(0)||d2c(10)) otherwise rslt=translate(rslt," ",d2c(0)||d2c(10)) end /*select*/ return rslt /** _stripint v.4 **/ _stripint: procedure expose (globals) mask=_space(translate(arg(1)," ","-0123456789"," "),0) rslt=_space(translate(arg(1)," ",mask," "),0) if left(rslt,1)="-" then rslt="-"||_space(translate(rslt," ","-"),0) else rslt=_space(translate(rslt," ","-"),0) if \datatype(rslt,"W") then rslt="" return rslt /** _commsg v.4 **/ _commsg: procedure expose (globals) select when lower(arg(1))="f" then do ch="`" wlong="Federation comm-link terminated." wshort="Message sent on Federation comm-link." end /*when*/ when lower(arg(1))="r" then do ch="'" wlong="Sub-space comm-link terminated" wshort="Message sent on sub-space channel" end /*when*/ otherwise call _error "missing message mode flag." end /*select*/ if arg(2)\="" then do if arg(3)="" then do call zocsend ch||"REV-SCRIPT: "||arg(2)||"^M" if zocwait(wshort)=640 then call _error "timeout" end /*do*/ else do i=2 call zocsend ch||"^MREV-SCRIPT: " do while arg(i)\="" call zocsend arg(i)||"^M" i=i+1 end /*do*/ call zocsend "^M" if zocwait(wlong)=640 then call _error "timeout" end /*else*/ end /*if*/ return /** _space v.1 **/ _space: procedure expose (globals) str=strip(arg(1)) if arg(2,"E") then n=arg(2); else n=1 if arg(3,"E") then pad=arg(3); else pad=" " rslt=word(str,1) do i=2 to words(str) rslt=rslt||copies(pad,n)||word(str,i) end /*do*/ return rslt /** _dwords v.2 **/ _dwords: procedure expose (globals) rslt=words(translate(arg(1),arg(2)||" "," "||arg(2))) return rslt /** _instr v.3 **/ _instr: procedure expose (globals) fnd=arg(1) str=arg(2) if lower(arg(3))\="cs" then do fnd=lower(fnd) str=lower(str) end /*if*/ if arg(1,"E") & arg(2,"E") & pos(fnd,str)>0 then rslt=1 else rslt=0 return rslt /** _dword v.2 **/ _dword: procedure expose (globals) rslt=translate(word(translate(arg(1),arg(3)||" "," "||arg(3)),arg(2))," "||arg(3),arg(3)||" ") return rslt /** _ansi v.3 **/ _ansi: procedure expose (globals) rslt="0" do i=1 to _dwords(arg(1),";") w=_dword(arg(1),i,";") select when w="dl" then rslt=rslt||";"||0 /* dull */ when w="bt" then rslt=rslt||";"||1 /* bright */ when w="ul" then rslt=rslt||";"||4 /* underlined */ when w="blk" then rslt=rslt||";"||5 /* blinking */ when w="fbk" then rslt=rslt||";"||30 /* black foreground */ when w="frd" then rslt=rslt||";"||31 /* red foreground */ when w="fgr" then rslt=rslt||";"||32 /* green foreground */ when w="fye" then rslt=rslt||";"||33 /* yellow foreground */ when w="fbl" then rslt=rslt||";"||34 /* blue foreground */ when w="fmg" then rslt=rslt||";"||35 /* magenta foreground */ when w="fcy" then rslt=rslt||";"||36 /* cyan foreground */ when w="fwh" then rslt=rslt||";"||37 /* white foreground */ when w="bbk" then rslt=rslt||";"||40 /* black background */ when w="brd" then rslt=rslt||";"||41 /* red background */ when w="bgr" then rslt=rslt||";"||42 /* green background */ when w="bye" then rslt=rslt||";"||43 /* yellow background */ when w="bbl" then rslt=rslt||";"||44 /* blue background */ when w="bmg" then rslt=rslt||";"||45 /* magenta background */ when w="bcy" then rslt=rslt||";"||46 /* cyan background */ when w="bwh" then rslt=rslt||";"||47 /* white background */ otherwise nop end /*select*/ end /*do*/ rslt="^[["||rslt||"m" return rslt /** _stripnum v.3 **/ _stripnum: procedure expose (globals) mask=_space(translate(arg(1)," ","-0123456789."," "),0) rslt=_space(translate(arg(1)," ",mask," "),0) if left(rslt,1)="-" then rslt="-"||_space(translate(rslt," ","-"),0) else rslt=_space(translate(rslt," ","-"),0) if _dwords(rslt,".")>2 then rslt=_dword(rslt,1,".")||"."||_space(translate(substr(rslt,pos(".",rslt)+1)," ","."),0) if \datatype(rslt,"N") then rslt="" return rslt /** _fileexists v.3 **/ _fileexists: procedure expose (globals) if \arg(1,"E") then call _error "missing parameter in _fileexists" if stream(arg(1), "C", "QUERY EXISTS")="" then rslt=0; else rslt=1 return rslt